unit ShowTree ;

interface

uses
    Windows,
    SysUtils,
    Classes,
    Controls,
    VirtualTrees,
    VTHeaderPopup,
    dtpPage,
    dtpShape,
    dtpLineShape,
    dtpGroupShape,
    dtpPolygonShape ;

type
    TShowTree = class
    private
        fRootNode : TdtpPage ;
        fViewer : TVirtualStringTree ;
        procedure GetNodeDataSize( Sender : TBaseVirtualTree ;
            var NodeDataSize : Integer ) ;
        procedure GetText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Column : TColumnIndex ; TextType : TVSTTextType ;
            var CellText : WideString ) ;
        procedure InitChildren( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            var ChildCount : Cardinal ) ;
        procedure InitNode( Sender : TBaseVirtualTree ; ParentNode,
            Node : PVirtualNode ; var InitialStates : TVirtualNodeInitStates ) ;
        procedure SetViewer( const Value : TVirtualStringTree ) ;
        procedure SetRootNode( Value : TdtpPage ) ;
    public
        property Viewer : TVirtualStringTree read fViewer write SetViewer ;
        property RootNode : TdtpPage read fRootNode write SetRootNode ;
        procedure SelectNode( node : PVirtualNode ) ;
        procedure Invalidate ;
    end ;

    PTreeData = ^TTreeData ;
    TTreeData = record
        FObject : TObject ;
    end ;

implementation

procedure TShowTree.SetViewer( const Value : TVirtualStringTree ) ;
begin
    fViewer := Value ;
    if fViewer = nil then
        Exit ;
    fViewer.OnInitNode := InitNode ;
    fViewer.OnInitChildren := InitChildren ;
    fViewer.OnGetNodeDataSize := GetNodeDataSize ;
    fViewer.OnGetText := GetText ;
end ;

procedure TShowTree.SetRootNode( Value : TdtpPage ) ;
var
    Node            : PVirtualNode ;
    Data            : PTreeData ;
begin
    fRootNode := Value ;
    fViewer.Clear ;
    fViewer.NodeDataSize := SizeOf( TTreeData ) ;
    Node := fViewer.AddChild( nil ) ;
    Data := fViewer.GetNodeData( Node ) ;
    Data^.FObject := fRootNode ;
    fViewer.FullExpand( nil ) ;
end ;

procedure TShowTree.InitNode( Sender : TBaseVirtualTree ; ParentNode,
    Node : PVirtualNode ; var InitialStates : TVirtualNodeInitStates ) ;
begin
    InitialStates := InitialStates + [ ivsHasChildren ] ;
end ;

procedure TShowTree.InitChildren( Sender : TBaseVirtualTree ;
    Node : PVirtualNode ; var ChildCount : Cardinal ) ;
var
    i               : integer ;
    Data, ChildData : PTreeData ;
    ChildNode       : PVirtualNode ;
begin
    ChildCount := 0 ;
    if assigned( Node ) then begin
        Data := fViewer.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.FObject ) then begin
            if Data^.FObject is TdtpPage then
                for i := 0 to ( Data^.FObject as TdtpPage ).ShapeCount - 1 do begin
                    ChildNode := fViewer.AddChild( Node ) ;
                    ChildData := fViewer.GetNodeData( ChildNode ) ;
                    ChildData^.FObject := ( Data^.FObject as TdtpPage ).Shapes[ i ] ;
                    ChildCount := ChildCount + 1 ;
                end
            else if Data^.FObject is TdtpLineShape then begin
                for i := 0 to ( Data^.FObject as TdtpLineShape ).ShapeCount - 1 do begin
                    ChildNode := fViewer.AddChild( Node ) ;
                    ChildData := fViewer.GetNodeData( ChildNode ) ;
                    ChildData^.FObject := ( Data^.FObject as TdtpLineShape ).Shapes[ i ] ;
                    ChildCount := ChildCount + 1 ;
                end ;
                for i := 0 to ( Data^.FObject as TdtpLineShape ).PointCount - 1 do begin
                    ChildNode := fViewer.AddChild( Node ) ;
                    ChildData := fViewer.GetNodeData( ChildNode ) ;
                    ChildData^.FObject := ( Data^.FObject as TdtpLineShape ).Arrows[ i ] ;
                    ChildCount := ChildCount + 1 ;
                end ;
            end
            else if Data^.FObject is TdtpShape then
                for i := 0 to ( Data^.FObject as TdtpShape ).ShapeCount - 1 do begin
                    ChildNode := fViewer.AddChild( Node ) ;
                    ChildData := fViewer.GetNodeData( ChildNode ) ;
                    ChildData^.FObject := ( Data^.FObject as TdtpShape ).Shapes[ i ] ;
                    ChildCount := ChildCount + 1 ;
                end
        end ;
    end ;
end ;

procedure TShowTree.GetNodeDataSize( Sender : TBaseVirtualTree ;
    var NodeDataSize : Integer ) ;
begin
    NodeDataSize := SizeOf( TTreeData ) ;
end ;

procedure TShowTree.GetText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
    Column : TColumnIndex ; TextType : TVSTTextType ; var CellText : WideString ) ;
const
    ArrowStyles     : array[ TdtpArrowStyle ] of string = (
        'none', 'arrow', 'open', 'stealth', 'diamond', 'oval' ) ;
var
    Data            : PTreeData ;
begin
    CellText := '{nil}' ;
    if assigned( Node ) then begin
        CellText := '{error}' ;
        Data := fViewer.GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.FObject ) then
            case Column of
                0 : begin
                        if Data^.FObject is TdtpPage then
                            CellText := ( Data^.FObject as TdtpPage ).Name
                        else if Data^.FObject is TdtpRoundRectShape then
                            CellText := 'Rounded Rect'
                        else if Data^.FObject is TdtpRectangleShape then
                            CellText := 'Rectangle'
                        else if Data^.FObject is TdtpGroupShape then
                            CellText := 'Group'
                        else if Data^.FObject is TdtpLineShape then
                            CellText := 'Line'
                        else if Data^.FObject is TdtpArrow then
                            CellText := 'Arrow'
                        else begin
                            CellText := Data^.FObject.ClassName ;
                            Exit ;
                        end ;
                        if Data^.FObject is tdtpShape then
                            Sender.Selected[ Node ] := ( Data^.FObject as tdtpShape ).Selected ;
                    end ;
                1 : if Data^.FObject is TdtpPage then
                        CellText := 'Shapes: ' + IntToStr( ( Data^.FObject as TdtpPage ).ShapeCount )
                    else if Data^.FObject is TdtpRoundRectShape then
                        with Data^.FObject as TdtpRoundRectShape do
                            CellText := Format( '(%.3g, %.3g, %.3g, %.3g)', [ Left, Top, Right, Bottom ] )
                    else if Data^.FObject is TdtpRectangleShape then
                        with Data^.FObject as TdtpRectangleShape do
                            CellText := Format( '(%.3g, %.3g, %.3g, %.3g)', [ Left, Top, Right, Bottom ] )
                    else if Data^.FObject is TdtpGroupShape then
                        with Data^.FObject as TdtpGroupShape do
                            CellText := Format( '(%.3g, %.3g, %.3g, %.3g)', [ Left, Top, Right, Bottom ] )
                    else if Data^.FObject is TdtpLineShape then
                        with Data^.FObject as TdtpLineShape do
                            CellText := Format( '(%.3g, %.3g), (%.3g, %.3g)', [ Points[ 0 ].X, Points[ 0 ].Y, Points[ 1 ].X, Points[ 1 ].Y ] )
                    else if Data^.FObject is TdtpArrow then
                        CellText := ArrowStyles[ ( Data^.FObject as TdtpArrow ).Style ]
                    else
                        CellText := '' ;
            end ;
    end ;
end ;

procedure TShowTree.SelectNode( node : PVirtualNode ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := fViewer.GetNodeData( Node ) ;
        if assigned( Data ) and
            assigned( Data^.FObject ) and
            ( Data^.FObject is tdtpShape ) then
            ( Data^.FObject as tdtpShape ).Selected := fViewer.Selected[ Node ] ;
    end ;
end ;

procedure TShowTree.Invalidate ;
begin
    if fViewer <> nil then
        fViewer.Invalidate ;
end ;

initialization
    DecimalSeparator := '.' ;

end.

